#!/usr/bin/perl -w

#------------------------------------------------------------------------------
# Author:  Marelie Davel (marelie.davel@gmail.com)
#------------------------------------------------------------------------------

use strict;
use warnings;

#------------------------------------------------------------------------------

sub print_usage() {
  print "Usage: predict.pl alt <in:word> <in:rules> <in:symbols>\n";
  print "       predict.pl alt_list <in:list> <in:rules> <in:symbols> <out>\n";
  print "       predict.pl best_list <in:list> <in:rules> <in:symbols> <out:result>\n";
}

#------------------------------------------------------------------------------
# Helper functions
#------------------------------------------------------------------------------

sub fread_rules($\%\@) {
  my ($rulesName,$symbolsP,$ruleP)=@_;
  open my $rules, '<:encoding(utf8)', $rulesName or die "Cannot open $rulesName";
  @$ruleP=();
  while (<$rules>) {
    chomp;
    my @parts = split /;/;
    if (scalar @parts != 6) {
      die "Error: rule file format error: $_\n";
    }
    my $class = $parts[3];
    if (!(exists $symbolsP->{$class})) {
      die "Error: unknown symbol $class\n";
    }
    my $rule = sprintf "%s:%s",$parts[1],$symbolsP->{$class};
    push @$ruleP, $rule;
  }
  close $rules;
}

sub fread_symbols($\%) {
  my ($symName,$symbolP)=@_;
  open my $symbols, '<:encoding(utf8)', $symName or die "Cannot open $symName";
  %$symbolP=();
  while (<$symbols>) {
    chomp;
    my @parts = split /\t/;
    if (scalar @parts != 2) {
      die "Error: symbol file format error: $_\n";
    }
    $symbolP->{$parts[1]}=$parts[0];
  }
  close $symbols;
}

sub find_alts($\@\@) {
  my ($word,$rulesP,$altP) = @_;
  my $ri;
  my $alt;
  for ($ri=$#$rulesP;$ri--;0) {
    my ($rule,$class) = split /:/,$rulesP->[$ri];
    if ($word =~ /$rule$/) {
      if ($class =~ /R(.*)>/) {
        my $wordEnd = $1;
        if ($word =~ /$wordEnd$/) {
          $alt = sprintf "%s\t(%d)",$class,$ri;
          push @$altP,$alt;
        }
      } else {
        $alt = sprintf "%s\t(%d)",$class,$ri;
        push @$altP,$alt;
      }
    }
  }
}

sub rewrite($) {
  my $instr = shift @_;
  $instr =~ s/#/ /g;
  $instr =~ s/@/'/g;
  $instr =~ s/%/-/g;
  return $instr;
}

#------------------------------------------------------------------------------
# Main functionality
#------------------------------------------------------------------------------

sub do_alt($$$) {
  my ($word,$rulesName,$symName)=@_;
  my @rList=();
  my %sList=();
  my @alts=();
  fread_symbols($symName,%sList);  
  fread_rules($rulesName,%sList,@rList);
  $word =~ s/ /#/g;
  $word =~ s/-/%/g;
  $word =~ s/'/@/g;
  find_alts($word,@rList,@alts);
  print "Alternatives for $word:\n";
  foreach my $a (@alts) {
    printf "%s\n", rewrite($a);
  }
}

sub do_alt_list($$$$) {
  my ($inName,$rulesName,$symName,$outName)=@_;
  open my $in, '<:encoding(utf8)', $inName or die "Cannot open $inName";
  open my $out, '>:encoding(utf8)', $outName or die "Cannot open $outName";

  my @rList=();
  my %sList=();
  fread_symbols($symName,%sList);  
  fread_rules($rulesName,%sList,@rList);

  while (<$in>){
    chomp;
    my @alts=();
    find_alts($_,@rList,@alts);
    print $out "Alternatives for $_:\n";
    foreach my $a (@alts) {
      printf $out "%s\n", rewrite($a);
    }
  }
  close $in;
  close $out;
}


sub do_best_list($$$$) {
  my ($inName,$rulesName,$symName,$outName)=@_;
  open my $in, '<:encoding(utf8)', $inName or die "Cannot open $inName";
  open my $out, '>:encoding(utf8)', $outName or die "Cannot open $outName";

  my @rList=();
  my %sList=();
  fread_symbols($symName,%sList);  
  fread_rules($rulesName,%sList,@rList);

  
  while (<$in>){
    chomp;
    my @alts=();
    my $w = $_;
    $w =~ s/ /#/g;
    $w =~ s/-/%/g;
    $w =~ s/'/@/g;
    find_alts($w,@rList,@alts);
    my $classID = $alts[0];
    $classID =~ s/([a-z\)])\s+\([0-9]*\)/$1/;
    printf $out "%s\t%s\n",$_,rewrite($classID);
  }
  close $in;
  close $out;
}

#------------------------------------------------------------------------------

if (scalar @ARGV < 3) {
  print_usage();
  exit;
} elsif (($ARGV[0] eq "alt")&&(scalar @ARGV==4)) {
  do_alt($ARGV[1],$ARGV[2],$ARGV[3]);
} elsif (($ARGV[0] eq "alt_list")&&(scalar @ARGV==5)) {
  do_alt_list($ARGV[1],$ARGV[2],$ARGV[3],$ARGV[4]);
} elsif (($ARGV[0] eq "best_list")&&(scalar @ARGV==5)) {
  do_best_list($ARGV[1],$ARGV[2],$ARGV[3],$ARGV[4]);
} else {
  print_usage();
  exit;
}

#------------------------------------------------------------------------------

